perm filename XIP.FAI[0,BGB]1 blob
sn#109012 filedate 1974-07-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00039 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.
C00010 00003 TEXT BUFFER SPECIFICATIONS.
C00013 00004 START ADDRESS ENTRY & MAIN EXECUTION.
C00016 00005 FOUR INITIALIZATION ROUTINES.
C00020 00006 SUBR(XGPOUT) OUTPUT XGP BUFFER.
C00023 00007 SUBR(EOPAGE) END OF PAGE.
C00025 00008 SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00028 00009 SUBR(GETCHR) GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
C00029 00010 SUBR(GETFIL) GET FILE SPECIFICATION - SKIP OK.
C00031 00011 FONT SPECIFICATION.
C00034 00012 SUBR(DEFONT) DEFINE FONT NUMERAL N TAKES N FROM AC-1.
C00036 00013 SUBR(SETFNT) SETUP A FONT, IMPLICIT ARGUMENT FONT.
C00038 00014 ASCII JUMP TABLE.
C00042 00015 TEXT JUSTFICATION MODES.
C00044 00016 HTAB:
C00045 00017 SET INTER LINE SPACING DEFAULT. "λ<number>" COMMAND.
C00046 00018 SUBR(JUSTIFY) PRINT A JUSTIFIED PARAGRAPH OF TEXT.
C00049 00019 SUBR(LNSCAN) LINE SCAN FOR SPACES COUNT.
C00053 00020 SUBR(LNJUST) LINE JUSTIFY AND PRINT.
C00056 00021 SUBR(TJLINE) CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
C00058 00022 FONT SELECT DELIMITERS.
C00060 00023 SUBR(MKSEG0) MAKE LINE SEGMENT.
C00063 00024 SUBR(MKSEG1) MAKE HEAVY LINES.
C00064 00025 SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
C00067 00026 EXECUTE III TEXT.
C00070 00027 EXECUTE VECTORS.
C00073 00028 SUBR(VIDEO)
C00077 00029 SUBR(VIDEO2)
C00081 00030 SUBR(INFILE) INDIRECT FILE COMMAND "@".
C00083 00031 XIP COMMAND EXECUTION.
C00085 00032
C00087 00033 SUBR(SQRT,X)
C00091 00034 SUBR(REALIN)
C00093 00035 BEGIN REALIN INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
C00096 00036 SUBR(DPYDOT,X,Y) DISPLAY A DOT.
C00099 00037 SUBR(RNDBOX,WID,HGH,RAD) BOX WITH ROUNDED CORNERS AT ROW,COL.
C00103 00038 SUBR(XBOX) "B <width> <height>"
C00106 00039 SUBR(CIRC,RAD,ARCORG,ARCLEN) RADIUS - ARC ORG - ARC LENGTH.
C00109 ENDMK
C⊗;
TITLE XIP - XEROX IMMEDIATE DOCUMENT PRINTER - BGB - 24 MARCH 1974.
;ALTERNATE PDP-10 MNEMONICS.
OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF DZM[SETZM]↔OPDEF GO[JRST]
OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
↓P←←17
DEFINE POP0J<POPJ P,>
↓POP1J.:↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2 ;DECLARE ACCUMULATORS.
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){FOR VARNAM⊂(LIST)<VARNAM:0↔>}
;MACROS TO SAVE AND RESTORE AC'S - SAVAC, GETAC.
DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;SAIL LIKE SUBROUTINE LINKAGE.
DEFINE CAT $(A,B){A$B} ;CONCATENATION.
.PLEVEL←←0 ;PDL BACK POINTER.
.SLEVEL←←0 ;DEPTH OF NESTED SUBROUTINE DECLARATIONS.
;SUBROUTINE DECLARATION MACROS - SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
↓NAME:;}
;DEFINE ARGUMENT NAME MACRO.
DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }
;SUBROUTINE CALLING MACROS - CALL & SETQ.
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
IFDIF<><NAME>{PUSHJ P,NAME }
.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;STACK ACCESSING MACROS - PUSHP & POPP.
DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
DEFINE POPP(ARG) {POP P,ARG↔.PLEVEL←←.PLEVEL-1}
;TEXT BUFFER SPECIFICATIONS.
CHRCNT: 0 ;NUMBER OF CHARACTERS REMAINING.
TXTPTR: 0 ;CURRENT TEXT POINTER.
TXTORG: 0 ;ORIGIN OF TEXT BUFFER.
TXTEND: 0 ;END OF TEXT BUFFER.
;MAIN SCANNER STATE.
CMODE: 0 ;-1 COMMAND MODE. 0 TEXT MODE.
ESC: 32 ;ESCAPE CHARACTER - DEFAULT TILDE.
XLINE: 5 ;EXTRA LINES BETWEEN ROWS OF CHARACTERS
EOP: 0 ;END OF PAGE FLAG.
EOF: 0 ;END OF FILE.
CHAR: 0 ;CURRENT CHARACTER.
;RESULTS: DISK FILE SPECIFICATION.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
;XGP RASTER SPECIFICATIONS.----------------------------------------------------
;XGP PSEUDO BEAM POSITION.
ROW: 0
COL: 0
;XGP RASTER PAGE BUFFER.
ORGXGP:0 ;XGP BUFFER IN CORE.
ENDXGP:0
;XGP RASTER DIMENSIONS.
WWIDTH←←=36 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1260.
MROWS←←=1900 ;NUMBER OF ROWS IS 1900.
BUFSIZ←←WWIDTH*MROWS
;III BUFFER DISPLAY.
IIIDX: =1024
IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
DROW:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
DCOL:0
COLMIN: 0 ;OF 1260 COLUMNS.
COLMAX: =1260
ROWMIN: =150 ;OF 1900 ROWS.
ROWMAX: =1800
TJMODE: -1 ;AUTO CRLF MODE.
TJFLAG: 0 ;-1 CENTER, +1 RIGHT JUSTIFICATION.
HEAVY: 0 ;LINE THICKNESS.
HEADER: 0 ;BYTE POINTER TO HEADER STRING.
HEADCN: 0 ;CHARACTER COUNT OF HEADER.
PAGENO: 0 ;PAGE NUMBER.
XGP2D: BLOCK =2048 ;2-D BIT ADDRESSING TABLE.
;START ADDRESS ENTRY & MAIN EXECUTION.
;------------------------------------------------------------------------------
PDL: BLOCK 100
SA: CALLI↔LAC P,[IOWD 100,PDL] ;CONTROL PUSH DOWN.
SETOM CMODE ;COMMAND MODE.
LAC[XWD FONTAB,FONTAB+1] ;CLEAR FONT CORE ADDRESSES.
DZM FONTAB↔BLT FNTPPN-1
LAC[SIXBIT/LPTFNT/] ;INPUT DEFAULT FONT.
HLLZM FILNAM↔HRLZM EXTION
LAC FNTPPN↔DAC PPPN
MOVEI 1↔DAC FONT ;FONT NUMERAL 1.
CALL(<DEFONT+1>)
CALL(MKXBUF) ;MAKE XGP BUFFER,
CALL(MKTABL) ;MAKE XGP 2-D ADDRESS TABLE.
CALL(COMSCAN) ;COMMAND LINE SCAN.
DZM EOF ;END OF FILE, END OF PAGE.
BEGIN MAIN;.............................
L0: LAC ROWMIN↔DAC ROW
LAC COLMIN↔DAC COL↔DZM EOP
L1: SKIPE EOP↔GO L3 ;END OF PAGE ?
CALL(GETCHR) ;FETCH A CHARACTER.
SKIPE EOF↔GO L3 ;END OF FILE ?
SKIPE CMODE↔GO[SETZ ;TEXT OR COMMAND MODE ?
CAIGE 1,200↔CDR A00(1) ;COMMAND MODE CHARACTER.
SKIPE↔PUSHJ P,@0↔GO L1] ;EXECUTE A COMMAND.
CAILE 1,137↔GO L2
CAR 0,A00(1)↔TRZ %↔JUMPE 0,L2 ;TEXT MODE CHARACTER.
CALL(@0)↔GO L1 ;TEXT MODE SUBROUTINES.
L2: CALL(PRINT)↔GO L1 ;PRINT UNJUSTIFIED CHARACTER.
L3: CALL(XGPOUT) ;OUTPUT XGP PAGE BUFFER.
SKIPN EOF↔GO L0
EXIT
BEND MAIN;---------------------------------------------------------------------
;FOUR INITIALIZATION ROUTINES.
SUBR(MKXBUF) ;MAKE XGP PAGE BUFFER.
COMMENT .-----------------------------------------------------------.
CDR JOBFF↑↔ADDI 10↔DAC ORGXGP
ADDI BUFSIZ-1↔DAC ENDXGP↔ADDI =40↔DAP JOBFF
CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER.)]
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@JOBREL↑
POP0J
ENDR MKXBUF;3/24/74(BGB)---------------------------------------------
SUBR(MKFRAM) ;MARKS BORDER OF XGP BUFFER ON PAGE.
COMMENT .-----------------------------------------------------------.
SETO ;BLACK BITS.
LAC 1,ORGXGP↔MOVEI 2,MROWS
L1: DPB 0,[POINT 9,1(1),8] ;LEFT BORDER 9-BITS WIDE.
DPB 0,[POINT 9,=35(1),35] ;RIGHT BORDER 9-BITS WIDE.
ADDI 1,WWIDTH↔SOJG 2,L1
MOVSI 1,-9*=36
HRR 1,ORGXGP
L2: SETOM (1) ; TOP OF HEADER.
SETOM =91*=36(1) ; TOP OF TEXT AREA.
SETOM =1791*=36(1) ;BOTTOM OF TEXT AREA.
SETOM =1891*=36(1) ;BOTTOM OF FOOTER.
AOBJN 1,L2↔POP0J
ENDR MKFRAM;---------------------------------------------------------
SUBR(COMSCAN) ;INITIAL COMMAND LINE SCAN.
COMMENT .---------------------------------------------------------------------.
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
RESCAN↔INCHSL↔EXIT ;READ CHARACTER LEFT OF SEMICOLON.
CAIN 15↔EXIT ;EXIT NO SEMICOLON.
CAIE";"↔GO .-5↔DZM CHRCNT
CDR JOBFF↔HRLI 440700 ;TEXT BUFFER POINTERS.
DAC TXTPTR↔DAC TXTORG
INCHSL 1↔EXIT ;READ FIRST CHARACTER.
DZM BUGFLG#↔CAIN 1,"!" ;"!" FORCES WAIT AFTER RESCAN.
SETOM BUGFLG↔GO .+3
INCHSL 1↔GO .+4↔AOS CHRCNT ;READ REMAINING CHARACTERS.
IDPB 1,0↔GO .-4↔DAC TXTEND
SKIPN BUGFLG↔POP0J
OUTSTR[ASCIZ/BEGIN./] ;WAIT FOR DEBUGGER.
INCHRW↔CRLF↔POP0J
ENDR COMSCAN;3/25/74(BGB)------------------------------------------------------
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
COMMENT .---------------------------------------------------------------------.
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔AOS
TLO 4301↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=2048,XGP2D ;2 AOBJN TABLE POINTER TO TABLE.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
ENDR MKTABL;BGB 24 MAY 1973 ---------------------------------------------------
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,XGP2D(C)↔ROT 1,6↔HRRI 1,@XGP2D(R)↔DPB 0,1}
SUBR(XGPOUT) OUTPUT XGP BUFFER.
COMMENT .---------------------------------------------------------------------.
SKIPE PAGENO↔CALL(EOPAGE) ;PAGE NUMBERING.
;PUT XGP CONTROL WORD IN EACH ROW.
LAC 0,[1B11+=250B23+WWIDTH-1] ;COLUMN ZERO POSITION.
LAC 1,ORGXGP↔MOVEI 2,MROWS
DAC 0,(1)↔ADDI 1,WWIDTH↔SOJG 2,.-2
MOVSI -BUFSIZ-5 ;2+BUFSIZ+3
HRR ORGXGP↔SUBI 3
DAC DUMARG ;DUMP ARGUMENT.
;SETUP END CUTS AND SPACES.
LAC 1,ORGXGP↔SUBI 1,3
PUSH 1,[1B0] ;CUT AT TOP OF PAGE.
PUSH 1,[=130B11] ;3/4" MARGIN SPACE AT TOP OF PAGE.
LAC 1,ENDXGP
PUSH 1,[=170B11] ;3/4" MARGIN SPACE AT BOTTOM OF PAGE.
PUSH 1,[1B0] ;CUT AT THE BOTTOM OF PAGE.
PUSH 1,[0] ;LAST WORD OF XGP BUFFER.
;PRINT A PAGE ON THE XGP.
L1: LAC PAGENO↔SKIPA↔GO L2 ;FOR PATCHING
INIT 2,17↔SIXBIT/XGP/↔0↔GO[
OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK
OUTSTR[ASCIZ/PAGE/]
CALL(TYPEPG) ;TYPE OUT PAGE NUMBER.
OUTSTR[ASCIZ/ TO XGP.../]
OUT 2,DUMARG
UNLOCK↔RELEASE 2,
L2: CDR ORGXGP↔SETZM@↔DIP↔AOS↔BLT @ENDXGP ;CLEAR XGP PAGE BUFFER.
OUTSTR[ASCIZ/FINISHED.
/]↔ SKIPE PAGENO↔AOS PAGENO ;INCREMENT PAGE COUNT.
LAC ROWMIN↔DAC ROW↔LAC COLMIN↔DAC COL↔DZM EOP ;TOP OF NEXT PAGE.
POP0J
DUMARG: 0↔0
ENDR XGPOUT;-------------------------------------------------------------------
SUBR(TYPEPG)
COMMENT .-----------------------------------------------------------.
SKIPN 1,PAGENO↔POP0J↔OUTCHR[" "]
CAIL 1,=100↔GO[IDIVI 1,=100↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+2]
CAIL 1,=10 ↔GO[IDIVI 1,=10 ↔ADDI 1,"0"↔OUTCHR 1↔LAC 1,2↔GO .+1]
ADDI 1,"0"↔OUTCHR 1↔POP0J
ENDR TYPEPG;---------------------------------------------------------
SUBR(EOPAGE) ;END OF PAGE.
COMMENT .---------------------------------------------------------------------.
PUSH P,TXTPTR↔PUSH P,CHRCNT↔PUSH P,EOF ;SAVE TEXT BUFFER STATUS.
MOVEI =1900↔DAC ROW↔SETOM TJFLAG ;BOTTOM CENTER OF PAGE.
;CONVERT PAGE NUMBER TO ASCII.
DZM CHRCNT↔LAC[POINT 7,TXT]↔DAC TXTPTR
MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
LAC PAGENO
CAIL =100↔GO[IDIVI =100
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+2]
CAIL =10 ↔GO[IDIVI =10
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT↔LAC 0,1↔GO .+1]
ADDI "0"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI " "↔IDPB TXTPTR↔AOS CHRCNT
MOVEI "-"↔IDPB TXTPTR↔AOS CHRCNT
MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
MOVEI 15 ↔IDPB TXTPTR↔AOS CHRCNT
LAC[POINT 7,TXT]↔DAC TXTPTR
;COMPUTE CENTER COLUMN AND PRINT.
CALL(TJLINE)↔SKIPA
L1: CALL(PRINT)↔CALL(GETCHR)
CAIE 1,15↔GO L1
;PRINT SECTION HEADING AT TOP OF PAGE FLUSH RIGHT.
SKIPN HEADER↔GO L3
MOVEI =2↔ADD DROW↔SUB XLINE↔DAC ROW↔SETZM TJFLAG
LAC HEADER↔DAC TXTPTR
LAC HEADCN↔DAC CHRCNT
CALL(TJLINE)↔SKIPA
L2: CALL(PRINT)↔CALL(GETCHR)
CAIE 1,15↔GO L2
;RESTORE TEXT BUFFER STATUS.
L3: POP P,EOF↔POP P,CHRCNT↔POP P,TXTPTR
POP0J
TXT: BLOCK 5
ENDR EOPAGE;---------------------------------------------------------
SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
COMMENT .---------------------------------------------------------------------.
;Implicit Arguments to PRINT are ROW, COL, CHAR,
;FONT, FONTAB, ORGXGP, ENDXGP, TJMODE.
ACCUMULATORS{G,B,B2,M,N,I,X16}
SKIPN CHAR↔POP0J ;IGNORE NULL CHARACTERS.
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP0J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,CHAR ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW
IMULI WWIDTH
ADD ORGXGP↔HRRZM B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL
SKIPE TJMODE↔GO .+3 ;CLIP LINE OVERFLOW IF TJMODE=0
CAML 0,COLMAX↔POP0J
IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
MOVEI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1
POP0J
ENDR PRINT;BGB 23 MAY 1973 ----------------------------------------------------
SUBR(GETCHR) GET A NON-NULL CHARACTER FROM THE TEXT BUFFER.
COMMENT .-----------------------------------------------------------.
SOSL CHRCNT↔GO[
ILDB 1,TXTPTR↔JUMPE 1,.-1
DAC 1,CHAR↔POP0J]
SETOM EOF↔SETZ 1,
POP0J
ENDR GETCHR;5/30/73(BGB)---------------------------------------------
SUBR(GETFIL) ;GET FILE SPECIFICATION - SKIP OK.
COMMENT .---------------------------------------------------------------------.
C ←← 1 ;CHARACTER. ;ACCUMULATORS.
N ←← 2 ;COUNT.
Q ←← 4 ;BYTE POINTER.
DZM FILNAM↔DZM EXTION ;CLEAR FILENAME SPECIFICATION.
DZM EXTION+1↔DZM PPPN
LAC Q,[POINT 6,FILNAM,-1]↔MOVEI N,6
L: CALL(GETCHR)
CAIN C,15↔GO[CALL(GETCHR)↔GO EOL]
CAILE C,"z"↔POP0J
CAIL C,"a"↔SUBI C,40 ;CONVERT LOWER CASE
CAIN C,"."↔GO[LAC Q,[POINT 6,EXTION,-1]↔MOVEI N,3↔GO L]
CAIN C,"["↔GO[LAC Q,[POINT 6,PPPN,-1] ↔MOVEI N,3↔GO L]
CAIN C,","↔GO[LAC Q,[POINT 6,PPPN,17] ↔MOVEI N,3↔GO L]
CAIN C,"]"↔CALL(GETCHR)
CAIN C,";"↔GO EOL ;XAP COMMAND POSTFIX.
CAIG C," "↔GO EOL
SOJL N,L↔SUBI C,40 ;COUNT'EM AND CONVERT TO SIXBIT.
IDPB C,Q↔GO L ;PACK CHARACTER INTO SPECIFICATIONS.
EOL:
CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
AOS(P)↔POP0J
ENDR GETFIL;5/30/73(BGB)---------------------------------------------
;FONT SPECIFICATION.
FONT: 1
FONTAB: BLOCK =45
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
;DEFAULT FONT NUMERAL NAMES.
FNTNAM: 0 ;0 "RON ZIEGLER" FONT (for inoperative statements).
;FIXED WIDTH FONTS.
SIXBIT/LPT/ ;1 LINE PRINTER.
SIXBIT/FIX13X/ ;2 FIXED WIDTH FONTS.
SIXBIT/FIX20/ ;3
SIXBIT/FIX25/ ;4
SIXBIT/FIX30/ ;5
SIXBIT/FIX40/ ;6
;NEWS GOTHIC.
SIXBIT/NGR13/ ;7 NEWS GOTHIC ROMAN.
SIXBIT/NGR20/ ;8
SIXBIT/NGR25/ ;9 LIGHTFACE.
SIXBIT/NGB25/ ;A BOLDFACE.
SIXBIT/NGR30/ ;B
SIXBIT/NGB30/ ;C
SIXBIT/NGR40/ ;D
;FANCY OR IRREGULAR FONTS.
SIXBIT/XMAS25/ ;E PSEUDO OLDE ENGLISH.
SIXBIT/BEESIX/ ;F
SIXBIT/GRK25/ ;G GREEK.
SIXBIT/SET1/ ;H TOVAR'S CREATION.
SIXBIT/SUB/ ;I
SIXBIT/SUP/ ;J
0 ;K
0 ;L
;BODONI.
SIXBIT/BDR25/ ;M
SIXBIT/BDI25/ ;N
SIXBIT/BDJ25/ ;O
SIXBIT/BDR25X/ ;P
SIXBIT/BDR30/ ;Q
SIXBIT/BDB30/ ;R
SIXBIT/BDR40/ ;S
SIXBIT/BDI40/ ;T
SIXBIT/BDR66/ ;U
0 ;V
0 ;W
;BASKERVILLE.
SIXBIT/BASB30/ ;X BOLDFACE.
SIXBIT/BASL30/ ;Y LIGHTFACE.
SIXBIT/BASI30/ ;Z ITALIC.
COMMENT ⊗ STANFORD FONT FILE FORMAT.---------------------------------
WORDS 0-177: XWD CHARACTER_WIDTH,CHARACTER_ADDRESS
WORDS 200-237: CHARACTER_SET_NUMBER ↔ HEIGHT ↔ MAX_WIDTH (IN BITS)
BASE LINE (BITS FROM TOP OF CHARACTER)
WORDS 240-377: ASCIZ/FONT DESCRIPTION/
REMAINDER OF FILE:
EACH CHARACTER:
CHARACTER_CODE,,WORD_COUNT+2
ROWS_FROM_TOP,,DATA_ROW_COUNT
BLOCK WORD_COUNT
--------------------------------------------------------------------⊗
SUBR(DEFONT) DEFINE FONT NUMERAL N; TAKES N FROM AC-1.
COMMENT .-----------------------------------------------------------.
DZM FILNAM ;ENTRY - SCAN FOR FILENAME.
INIT 1,17↔SIXBIT/DSK/↔0 ;ENTRY+1 - DON'T SCAN FILENAME.
GO[FATAL(CAN'T INIT DSK)]
DAC 1,FONTCH
SKIPE FILNAM↔GO L1
CALL(GETCHR)↔ANDI 1,17↔DAC 1,FONT ;FONT NUMERAL.
CALL(GETFIL)↔GO L3 ;FONT FILE NAME.
;FIND FONT FILE.
L1: LOOKUP 1,FILNAM↔GO[MOVEI 'FNT'↔SKIPN EXTION↔HRLZM EXTION
LOOKUP 1,FILNAM↔GO[LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
LOOKUP 1,FILNAM↔GO[OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔GO L3]↔GO L2]↔GO L2]
;DUMP INPUT FONT FILE TO TOP OF CORE.
L2: LAC 1,FONT↔CDR 2,JOBFF ;FONT NUMBER.
LAC 0,2↔DAC FONTAB(1) ;FONT BASE ADDRESS.
HLL PPPN↔SOS↔DAC INARG ;IOWD DUMP ARGUMENT.
MOVS PPPN↔MOVMS↔ADDI 1(2) ;TOP OF THE FONT.
DAP JOBFF↔CORE↔HALT ;EXPAND CORE.
IN 1,INARG↔SKIPA↔HALT
CALL(SETFNT)
L3: RELEASE 1,↔POP0J
↑FONTCH: 0
INARG:0↔0
ENDR DEFONT;2/7/73(TVR)2/25/73(BGB)----------------------------------
SUBR(SETFNT) SETUP A FONT, IMPLICIT ARGUMENT FONT.
COMMENT .-----------------------------------------------------------.
LAC 1,FONT↔CDR 2,FONTAB(1) ;GET FONT BASE ADDRESS.
SKIPN 2↔POP0J ;EXIT WHEN FONT MISSING.
MOVEI =40↔DAC DROW ;LINE FEED DEFAULT.
SKIPE 1,201(2)↔DAC 1,DROW ;LINE FEED SPECIFIED.
LAC XLINE↔ADDM DROW ;INTER LINE SPACING.
MOVEI =25↔DAC DCOL ;SPACE DEFAULT.
SKIPE 1,202(2)↔DAC 1,DCOL ;SPACE SPECIFIED.
POP0J
ENDR SETFNT;2/7/72(TVR)----------------------------------------------
SUBR(XFONT) ;"F<N>" FONT SELECT AND ENTER TEXT MODE.
COMMENT .-----------------------------------------------------------.
CALL(GETCHR)↔DZM CMODE
CAIN 1,"."↔GO L1 ;NO CHANGE.
CAIGE 1,"0"↔GO L1
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37
ADDI 1,=9↔GO .+1]
DAC 1,FONT
SKIPE FONTAB(1)↔GO L1 ;IS FONT IN CORE YET.
LAC FNTNAM(1)↔DAC FILNAM ;FONT NAME
LAC[SIXBIT/FNT/]↔DAC EXTION ;FONT EXTENSION.
LAC FNTPPN↔DAC PPPN ;DEFAULT FONT PPPN.
CALL(<DEFONT+1>)
L1: SKIPE TJFLAG↔CALL(TJLINE) ;CENTER OR RIGHT JUSTIFY.
POP0J
ENDR XFONT;3/26/74(BGB)----------------------------------------------
;ASCII JUMP TABLE.
;XWD TEXT_MODE,,COMMAND_MODE
A00: 0 ;null. ;00-07.
XSAVE ;"↓"
MKSECT ;"α" MAKE SECTION HEADING.
0 ;"β"
0 ;"∧"
0 ;"¬"
0 ;"ε"
0 ;"π"
XXLINE ;"λ" ;10↔17.
XWD %+HTAB,0 ;tab.
XWD %+LFEED,0 ;LF
0 ;VT.
XWD %+FFEED,FFEED;FF.
XWD %+CRETURN,0 ;CR.
0 ;"∞"
0 ;"∂"
XWD LFS+4,DFS+4 ;"⊂" LEFT FONT SELECT DELIMITER ;20-27.
XWD RFS+4,0 ;"⊃" RIGHT FONT SELECT DELIMITER
0 ;"∩"
0 ;"∪"
0 ;"∀"
MKFRAM ;"∃"
IIISIM ;"⊗" III DISPLAY BUFFER - CORNER ORIGIN.
0 ;"↔"
0 ;"_" ;30-37.
0 ;"→"
XWD ESCTXT,0 ;TILDE. ESCAPE TEXT MODE.
0 ;"≠"
XWD LFS+5,DFS+5 ;"≤" LEFT FONT SELECT DELIMITER
XWD RFS+5,0 ;"≥" RIGHT FONT SELECT DELIMITER
0 ;"≡"
0 ;"∨"
XWD %+SPACE,0 ;SPACE. ;40-47.
0 ;"!"
0 ;"""
0 ;"#"
0 ;"$"
0 ;"%"
0 ;"&"
0 ;"'"
XWD LFS+2,DFS+2 ;"(" LEFT FONT SELECT DELIMITER ;50-57.
XWD RFS+2,0 ;")" RIGHT FONT SELECT DELIMITER
IIISIM ;"*" III DISPLAY BUFFER - CENTER ORIGIN.
IIISIM ;"+"
0 ;","
0 ;"-"
0 ;"."
0 ;"/"
BLOCK 12;"0-9" ;60-67.
0 ;":" ;72-77.
0 ;";"
XWD LFS+5,DFS+5 ;"<" LEFT FONT SELECT DELIMITER
0 ;"="
XWD RFS+5,0 ;">" RIGHT FONT SELECT DELIMITER
0 ;"?"
INFILE ;"@" INDIRECT FILE COMMAND ;100-107.
0 ;"A"
XBOX ;"B"
XCIRCLE ;"C"
0 ;"D"
0 ;"E"
XFONT ;"F" SELECT FONT AND ENTER TEXT MODE.
0 ;"G"
XHEAVY ;"H" HEAVY LINES. ;110-117.
AI ;"I" ABSOLUTE INVISIBLE VECTOR.
XJUSTM ;"J"
0 ;"K"
XLOCUS ;"L" LOCUS (& LINE).
DEFONT ;"M" MAKE A FONT NUMBER.
0 ;"N"
XROTAT ;"O" SET ORIENTATION.
XSETPAGE ;"P" SET PAGE NUMBER. ;120-127.
FFEED+2 ;"Q"
XRADIAL ;"R"
XSWINE ;"S" MAKE ROUNDED BOX.
0 ;"T"
0 ;"U"
AV ;"V" ABSOLUTE VISIBLE VECTOR.
XWINDO ;"W"
XXSCAL ;"X" SET X SCALE. ;130-137.
0 ;"Y"
0 ;"Z"
XWD LFS+3,DFS+3 ;"[" LEFT FONT SELECT DELIMITER
0 ;"\"
XWD RFS+3,0 ;"]" RIGHT FONT SELECT DELIMITER
XRESTORE ;"↑"
0 ;"←"
BLOCK 8 ;140-147
BLOCK 8 ;150-157
BLOCK 8 ;160-167
0↔0↔0 ;"xyz" ;170-177
0 ;"{"
CARTOUCHE ;"|" BOX WITH ROUNDED CORNERS.
0 ;ALT
0 ;"}"
0 ;RUBOUT
;TEXT JUSTFICATION MODES.
;TJMODES: ;-1 JA AUTO CRLF DEFAULT.
; 0 JV VIDEO CLIPPED MODE.
;+1 JU JUSTIFY MODE.
;TJFLAG: ;-1 JC CENTER JUSTIFY A LINE.
;+1 JR RIGHT JUSTIFY A LINE.
;EXECUTE "J" COMMAND.------------------------------------------------
XJUSTM:
CALL(GETCHR)↔MOVEI 1
CAIN 1,"A"↔SETOM TJMODE ;JUSTIFY AUTOMATIC CRLF.
CAIN 1,"V"↔DZM TJMODE ;JUSTIFY VIDEO CLIPPED.
CAIN 1,"U"↔DAC TJMODE ;JUSTIFY LEFT & RIGHT.
CAIN 1,"C"↔SETOM TJFLAG ;JUSTIFY CENTER.
CAIN 1,"R"↔DAC TJFLAG ;JUSTIFY RIGHT.
POP0J
;--------------------------------------------------------------------
SPACE:
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
ADDM 0,COL ;NEW CARRIAGE POSITION.
POP0J
CRETURN:
LAC 1,COLMIN
DAC 1,COL
POP0J
LFEED:
LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
LAC 1,201(1) ;MAXIMUM HEIGHT.
ADD 1,XLINE
ADDB 1,ROW
CAML 1,ROWMAX↔SETOM EOP ;FALL OFF THE BOTTOM OF THE COLUMN.
POP0J
HTAB:
LAC 1,FONT ;THE FONT.
SKIPN 1,FONTAB(1)↔HALT
CAR 0," "(1) ;THE WIDTH OF A SPACE.
LAC 1,COL↔SUB 1,COLMIN ;CARRIAGE POSITION.
IDIV 1,0↔ANDCMI 1,7 ;THE OCTADE OF THE NUMBER OF SPACES.
ADDI 1,8 ;NEXT OCTADE.
IMUL 1,0 ;NEW CARRIAGE POSITION.
ADD 1,COLMIN↔DAC 1,COL
SKIPLE TJMODE ;SKIP WHEN MODE IS -1 OR 0.
GO JUSTIFY
POP0J
ESCTXT:
SETOM CMODE
POP0J ;ESCAPE TEXT - ENTER COMMAND MODE.
ESCCOM:
DZM CMODE
POP0J ;ESCAPE COMMAND - ENTER TEXT MODE.
FFEED:
SKIPLE TJMODE↔POP0J ;IGNORE FORM FEEDS UNDER JUSTIFICATION.
SETOM EOP
POP0J
;SET INTER LINE SPACING DEFAULT. "λ<number>" COMMAND.
XXLINE:
CALL(REALIN)
FIXX↔MOVMM XLINE
POP0J
;SET WINDOW (OR MARGINS). W<colmin>,<colmax>,<rowmin>,<rowmax>;
XWINDO:
CALL(REALIN)↔FIXX↔MOVMM COLMIN↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM COLMAX↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM ROWMIN↔CAIE 1,","↔POP0J
CALL(REALIN)↔FIXX↔MOVMM ROWMAX↔ POP0J
XSAVE: ;"↓" PUSH ROW COMMAND.
LAC SAVPDL
PUSH ROW
DAC SAVPDL
POP0J
XRESTORE: ;"↑" POP ROW COMMAND.
LAC SAVPDL
POP ROW
DAC SAVPDL
POP0J
SAVPDL: ;SAVE-RESTORE PDL.
IOWD 10,SAVPDL+1
BLOCK 10
SUBR(JUSTIFY) ;PRINT A JUSTIFIED PARAGRAPH OF TEXT.
COMMENT ⊗------------------------------------------------------------
A justified paragraph begins with a TAB and ends with one of
five possible terminations: 1. end of file; 2. escape character;
3. form feed; 4. CRLF-TAB; 5. CRLF-CRLF. The main role of this routine
is to find the end of the paragraph; then it calls LNSCAN and LNJUST
until all the full lines are printed.
;-------------------------------------------------------------------⊗
PUSH P,TXTPTR ;SAVE INITIAL STATE OF THE SCANNER.
PUSH P,CHRCNT
L1: LAC TXTPTR↔DAC ENDPTR ;SAVE PTR TO POTENTIAL END CHARACTER.
CALL(GETCHR)
SKIPE EOF↔GO L2 ;1. END OF FILE EXCLUSIVE.
CAMN 1,ESC↔GO L2 ;2. ESCAPE CHARACTER EXCLUSIVE.
CAIN 1,14 ↔GO L2 ;3. FORM FEED EXCLUSIVE.
CAIE 1,15 ↔GO L1 ;SKIP ON 1ST CARRIAGE RETURN.
;CARRIAGE RETURN LOOK AHEAD.
LAC 0,TXTPTR
ILDB 1,0↔CAIE 1,12↔GO L1 ;LINE FEED INCLUSIVE.
DAC 0,ENDPTR
ILDB 1,0↔CAIN 1,11↔GO L2 ;4. CRLF TAB.
CAIE 1,15↔GO L1 ;2ND CARRIAGE RETURN.
ILDB 1,0↔CAIE 1,12↔GO L1 ;5. CRLF CRLF.
;FOUND END OF PARAGRAPH (INCLUSIVE AND EXCLUSIVE).
L2: POP P,CHRCNT ;RESTORE SCANNER TO INITIAL POSITION.
POP P,TXTPTR
;PRINT ALL THE FULL LINES OF THE PARAGRAPH.
L3: PUSH P,FONT↔CALL(LNSCAN) ;LINE SCAN FOR SPACES.
POP P,0↔CAMN FONT↔GO .+3 ;RESTORE FONT AT START OF LINE.
DAC 0,FONT↔CALL(SETFNT)
CALL(LNJUST) ;LINE JUSTIFY AND PRINT.
SKIPE EOP↔CALL(XGPOUT) ;PAGE OVER FLOW.
LAC TXTPTR↔CAME ENDPTR↔GO L3 ;TEST FOR END OF PARAGRAPH.
POP0J
;BYTE POINTER TO LAST CHARACTER OF THE PARAGRAPH INCLUSIVE.
↑ENDPTR: 0 ;IMPLICIT ARGUMENT FOR LNSCAN.
ENDR JUSTIFY;9/20/73(BGB)--------------------------------------------
SUBR(LNSCAN) ;LINE SCAN FOR SPACES COUNT.
COMMENT ⊗------------------------------------------------------------
Scan for right margin overflow, while keeping track of the
number of spaces seen and the position of the last space seen.
--------------------------------------------------------------------⊗
ACCUMULATORS{CHR}
;INITIALIZATION.
LAC COL↔DAC COLUMN ;TJ LEFT MARGIN.
DZM SPACNT↔DZM SPAPTR↔DZM SPACOL
LAC TXTPTR↔DAC LNPTR
DZM SPAFLG ;IGNORE LEADING SPACES.
;TEST FOR END OF LINE SCAN.
L1: LAC LNPTR↔CAMN ENDPTR↔GO[ ;EXIT END OF PARAGRAPH.
DZM SPAPTR↔DZM SPACNT↔POP0J]
LAC COLUMN↔CAML COLMAX↔POP0J ;EXIT LINE FULL.
;FETCH A CHARACTER.
ILDB CHR,LNPTR
CAIN CHR,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN CHR,00↔GO L1 ;IGNORE NULLS.
CAIN CHR,11↔MOVEI CHR,40 ;CONVERT TAB INTO A SPACE.
CAIN CHR,15↔MOVEI CHR,40 ;CONVERT CR INTO A SPACE.
;SAVE THE STATUS OF THE LATEST SPACE.
CAIE CHR,40↔GO L2
AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
AOS SPACNT ;INCREMENT SPACE COUNT.
LAC COLUMN↔DAC SPACOL ;SAVE SPACE POSITION.
LAC LNPTR↔DAC SPAPTR ;SAVE SPACE BYTE POINTER.
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF SPACE.
SKIPE DOUBLE↔ASH 0,1 ;DOUBLE WIDTH SPACE.
ADDB 0,COLUMN↔GO L1
;DECODE FONT SELECT DELIMITERS.
L2: CAR A00(CHR)↔JUMPE L3 ;JUMPS WHEN NOT A FONT SELECT.
TRZE %↔GO L3 ;JUMPS WHEN NOT A FONT SELECT.
CALL(@0)↔GO L1 ;SKIPS WHEN NOT A FONT SELECT.
;ACCUMULATE CHARACTER WIDTHS - NOT SPACE.
L3: SETOM SPAFLG#↔DZM DOUBLE#
CAIN CHR,"."↔SETOM DOUBLE
CAIN CHR,"?"↔SETOM DOUBLE
LAC 1,FONT↔LAC 1,FONTAB(1) ;FONT BASE ADDRESS.
ADD 1,CHR↔CAR 0,(1) ;WIDTH OF CHARACTER.
ADDB 0,COLUMN↔GO L1
;GLOBAL VARIABLES FOR COMMUNICATION TO LNJUST.
↑LNPTR: 0 ;END OF LINE POINTER.
↑SPACNT:0 ;SPACE COUNT.
↑SPAPTR:0 ;BYTE POINTER TO LATEST SPACE.
↑SPACOL:0 ;COLUMN POSITION OF LATEST SPACE.
COLUMN: 0 ;LOOK AHEAD COLUMN POSITION.
ENDR LNSCAN;9/20/73(BGB)---------------------------------------------
SUBR(LNJUST) ;LINE JUSTIFY AND PRINT.
COMMENT .---------------------------------------------------------------------.
;IMPLICIT ARGUMENTS:
PTR←←14
LAC COLMAX↔SUB SPACOL↔DAC EXTRA ;EXTRA SPACE.
SKIPLE SPACNT↔SOS SPACNT↔DZM SPAFLG ;IGNORE LEADING SPACES.
;PRINT CHARACTERS - ADJUST SPACE SIZES.
L1: LAC TXTPTR
CAMN ENDPTR↔GO EOL ;TEST FOR END OF PARAGRAPH.
CAMN LNPTR↔GO EOL ;TEST FOR ABNORMAL END OF LINE.
CALL(GETCHR)↔LAC TXTPTR
CAMN SPAPTR↔GO EOL ;TEST FOR NORMAL END OF LINE.
CAIN 1,12↔GO L1 ;IGNORE LINEFEEDS.
CAIN 1,00↔GO L1 ;IGNORE NULLS.
CAIN 1,11↔MOVEI 1,40 ;CONVERT TAB INTO A SPACE.
CAIN 1,15↔MOVEI 1,40 ;CONVERT CR INTO A SPACE.
CAIE 1,40↔SETOM SPAFLG#
CAIE 1,40↔DZM DOUBLE# ;NOT SPACE - RESET.
CAIE 1,"."↔CAIN 1,"?"↔SETOM DOUBLE# ;PERIOD OR QUESTION MARK.
DAC 1,CHAR
;FONT SELECT DELIMITERS.
CAR A00(1)↔JUMPE .+5
TRZE %↔GO .+3
CALL(@0)↔GO L1
LAC 1,CHAR
;PRINT THE CHARACTER.
CAIN 1,40↔GO L2
CALL(PRINT)↔GO L1
;COMPUTE A VARIABLE SPACE SIZE.
L2: AOSE SPAFLG↔GO L1 ;IGNORE MULTIPLE SPACES.
SETZ↔SKIPN SPACNT↔GO L3 ;TEST FOR NO VARIABLE SPACES.
LAC 0,EXTRA↔IDIV 0,SPACNT
SOS SPACNT
LAC 1,EXTRA↔SUB 1,0↔DAC 1,EXTRA
;PRINT A VARIABLE SPACE.
L3: LAC 1,FONT
SKIPN 1,FONTAB(1)↔HALT
CAR 1,40(1) ;WIDTH OF NORMAL SPACE.
SKIPE DOUBLE↔ASH 1,1 ;DOUBLE WIDTH SPACE.
ADD 1,0↔ADDM 1,COL ;ADVANCE COL VARIABLE SPACE.
GO L1
;EXECUTE A CARRIAGE RETURN LINE FEED.
EOL: LAC COLMIN↔DAC COL ;CARRIAGE RETURN.
GO LFEED
DECLARE{EXTRA}
ENDR LNJUST;9/20/73(BGB)---------------------------------------------
SUBR(TJLINE) ;CENTER OR RIGHT JUSTIFY A LINE OF TEXT.
COMMENT .---------------------------------------------------------------------.
;SKIP OVER LEADING SPACES.
DZM TOTAL
PUSH P,TXTPTR↔PUSH P,CHRCNT ;SAVE SCANNER POSITION.
CALL(GETCHR)↔CAIE 1,40↔GO L1+1
POP P,0↔POP P,0↔GO TJLINE ;FLUSH THE STACK.
;FETCH A CHARACTER AND DO CONVERSIONS.
L1: CALL(GETCHR)
CAIN 1,00↔GO L1 ;IGNORE NULLS.
CAIN 1,11↔MOVEI 1,40 ;CONVERT TABS TO BLANKS.
;LINE TERMINATION ON CR OR ESCAPE
CAIN 1,15↔GO L2
CAMN 1,ESC↔GO L2
;ACCUMULATE CHARACTER WIDTH INTO TOTAL.
LAC 2,FONT↔LAC 2,FONTAB(2) ;FONT BASE ADDRESS.
ADD 2,1↔CAR 0,(2) ;WIDTH OF CHARACTER.
ADDM 0,TOTAL↔GO L1
;SET COLUMN FOR CENTER OR RIGHT JUSTIFICATION.
L2: LAC COLMAX↔SUB COLMIN↔SUB TOTAL ;EXTRA SPACE IN XGP UNITS.
MOVM↔SKIPGE TJFLAG↔ASH -1 ;HALVE WHEN CENTERING.
ADD COLMIN↔DAC COL
DZM TJFLAG
;RESTORE THE SCANNER AND EXIT.
POP P,CHRCNT↔POP P,TXTPTR
POP0J
DECLARE{TOTAL}
ENDR TJLINE;9/23/73(BGB)---------------------------------------------
;FONT SELECT DELIMITERS.
FSD:BLOCK 7
;FIVE PAIRS: {} () [] ⊂⊃ ≤≥
;DECLARE FONT SELECT DELIMITER - COMMANDS {N; (N; [N; ⊂N; ≤N;
DFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI DFS↔ADDI FSD
CALL(GETCHR)
CAIGE 1,"0"↔POP0J
CAIG 1,"9"↔ANDI 1,17
CAIL 1,"A"↔GO[ANDI 1,37↔ADDI 1,=9↔GO .+1]
DIP 1,@↔SKIPE FONTAB(1)↔POP0J ;IS IT LOADED YET.
PUSH P,FONT↔DAC 1,FONT
LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(<DEFONT+1>)↔POP P,FONT
POP0J
;LEFT FONT SELECT DELIMITER - TEXT MODE SELECT FONT.
LFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI LFS↔ADDI FSD
CAR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
EXCH 1,FONT↔DAP 1,@ ;SAVE RETURN FONT NUMBER.
CALL(SETFNT)
POP0J
;RIGHT FONT SELECT DELIMITER - TEXT MODE RESTORE FONT.
RFS: GO .+6↔GO .+5↔GO .+4
GO .+3↔GO .+2↔GO .+1
SUBI RFS↔ADDI FSD
CDR 1,@↔SKIPN 1↔GO[AOS(P)↔POP0J]
DAC 1,FONT
CALL(SETFNT)
POP0J
SUBR(MKSEG0) MAKE LINE SEGMENT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,Q,N} ↔ DR←←R2 ↔ DC←←C2
SKIPE HEAVY↔CALL(MKSEG1)
;CLIPPING - EASY INSIDER.
SETO
SKIPL R1↔CAIL R1,MROWS↔SETZ
SKIPL C1↔CAIL C1,NCOLS↔SETZ
SKIPL R2↔CAIL R2,MROWS↔SETZ
SKIPL C2↔CAIL C2,NCOLS↔SETZ
DAC FLAG#
;CLIPPING - EASY OUTSIDER.
L0: CAML R2,R1↔GO .+3 ;FORCE DOWN VECTOR.
EXCH R1,R2↔EXCH C1,C2
SKIPL R2↔CAIL R1,MROWS↔POP0J ;ROWS OUT OF BOUNDS.
LAC 0,C1↔LAC 1,C2
CAML 0,1↔EXCH 0,1
SKIPL 1↔CAIL 0,NCOLS↔POP0J ;COLUMNS OUT OF BOUNDS.
;INITIALIZE BIT PACK LOOP.
SUB R2,R1↔SUB C2,C1 ;DELTA ROWS & COLUMNS.
MOVEI (<AOS>) ;LEFT TO RIGHT VECTOR.
SKIPGE DC↔MOVEI (<SOS>) ;RIGHT TO LEFT VECTOR.
DIP L2+1↔DIP L5+1↔MOVMS DC ;OLDE FASHION PDP-1 DIP.
LAC N,DC↔CAMGE N,DR↔LAC N,DR ;NUMBER OF DOTS.
ASH DC,=17↔IDIV DC,N↔LAC DC ;DELTA COL PER DOT.
ASH DR,=17↔IDIV DR,N↔DAC DC ;DELTA ROW PER DOT.
DIP DR,DC↔SETZ Q↔SETO ;REMAINDER & BIT.
SKIPN FLAG↔GO L3
;LINE SEGMENT FULLY WITHIN WINDOW.
L1: DOT(R1,C1)↔ADD Q,DC ;PLOT THE DOT & ADVANCE.
TLZE Q,%↔AOS R1 ;ROW OVERFLOW.
L2: TRZE Q,%↔AOS C1 ;COL OVERFLOW.
SOJGE N,L1↔POP0J
;LINE SEGMENT PARTIALLY WITHIN WINDOW.
L3: JUMPL R1,L4↔CAIL R1,MROWS↔POP0J
JUMPL C1,L4↔CAIL C1,NCOLS↔GO L4
DOT(R1,C1)
L4: ADD Q,DC
TLZE Q,%↔AOS R1 ;ROW OVERFLOW.
L5: TRZE Q,%↔AOS C1 ;COL OVERFLOW.
SOJGE N,L3↔POP0J
ENDR MKSEG0;28 MARCH 1974 BGB;---------------------------------------
SUBR(MKSEG1) ;MAKE HEAVY LINES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,DR,DC,N}
LAC N,HEAVY↔PUSH P,HEAVY↔SETZM HEAVY
LAC DR,R1↔SUB DR,R2↔MOVMS DR
LAC DC,C1↔SUB DC,C2↔MOVMS DC
L1: SAVAC(8)↔CALL(MKSEG0)↔GETAC(8)
SOJLE N,[POP P,HEAVY↔POP0J]
CAMGE DR,DC↔GO[
AOS R1↔AOS R2↔GO L1] ;DOWNWARDS.
AOS C1↔AOS C2↔GO L1] ;RIGHTWARDS.
ENDR MKSEG1;28 MARCH 1974 BGB ---------------------------------------
SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{X,Y,R,C,IIIWRD}
;DELTA ORIGIN DISPLACEMENT.
MOVSI 1,(2B2)↔LAC CHAR↔DAC CMDCHR#
CAIN "*"↔SETZ 1,↔DAC 1,DELTA
;III FILE NAME.
CALL(GETFIL)↔POP0J
INIT 17,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/PLT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/III/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/DAT/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[LAC[SIXBIT/TMP/]↔DAC EXTION
LOOKUP 17,FILNAM↔GO[FATAL<III OR VIDEO FILE NOT FOUND.>]
GO L0]↔GO L0]↔GO L0]↔GO L0]
;EXPAND CORE FOR DUMP INPUT.
L0: LAC JOBREL↔DAC OLD44#
HLRE 1,PPPN↔MOVN 1,1
ADD 1,JOBREL↔DAC 1,BUFEND#
CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]
;SAVE CURRENT XGP BEAM POSITION.
LAC FONT↔DAC BEGFNT#
LAC COL↔DAC BEGCOL#
LAC ROW↔DAC BEGROW#
MOVEI 2↔DAC IIISIZ ;INITIAL III CHARACTER SIZE.
;DUMP III FILE IN.
LAC OLD44↔ADDM PPPN↔IN 17,PPPN
LAC 1,OLD44↔LAC(1)↔CAMN [-1]↔GO[ ;HE-VIDEO.
LAC CMDCHR↔CAIE "+"↔GO VIDEO↔GO VIDEO2] ;4 BY 4 OR 6 BY 6.
LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC# ;III PC.
SKIPN 1(1)↔AOS PC ;STEP OVER QUAM'S DEAD WORD.
L1: CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
CAML 1,JOBREL↔GO .+3
HRLI 1,-1(1)↔BLT 1,JOBREL ;CLEAR TOP.
CDR JOBREL↔DAP JOBFF
;FETCH AND DECODE III COMMAND WORD.
ILOOP: AOSA 1,PC
LOOP: LAC 1,PC↔CAMLE 1,OLD44
CAML 1,BUFEND↔GO RET
LAC IIIWRD,(1)
TRNE IIIWRD,01↔GO XTEXT ;TEXT COMMAND WORD.
TRNE IIIWRD,02↔GO XVECTR ;VECTOR COMMAND WORD.
TRNE IIIWRD,20↔GO XCTRL ;III CONTROL WORD.
TRNE IIIWRD,37↔GO ILOOP ;NOP & HALT COMMANDS.
RET: LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
FRET: RELEASE 17,
LAC BEGFNT↔DAC FONT
LAC BEGCOL↔DAC COL
LAC BEGROW↔DAC ROW
POP0J
;EXECUTE III TEXT.
XTEXT: PUSH P,IIIWRD ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,0(P)↔JUMPE 1,CCONT↔DAC 1,CHAR
CAIN 1,15↔GO[
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-12
MOVNS 1↔ADDM 1,YBEAM
LAC 1,[-511]↔DAC 1,XBEAM↔GO CCONT]
PUSH P,ROW↔PUSH P,COL ;SAVE XGP-BEAM POSITION.
;COMPUTE XGP ROW AND COLUMN.
MOVN R,YBEAM↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW↔DAC R,ROW
LAC C,XBEAM↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL↔DAC C,COL
LAC 1,IIISIZ↔LAC 1,CHRWID(1)↔ROT 1,-13↔ADDM 1,XBEAM
;COMPUTE FONT SIZE.
LAC 1,IIISIZ↔LAC CHRWID(1)↔FLOAT↔FMP SCALEX↔FIXX↔MOVEI 1,1
CAIL 0,=7↔AOS 1
CAIL 0,=20↔AOS 1↔CAIL 0,=25↔AOS 1
CAIL 0,=30↔AOS 1↔CAIL 0,=40↔AOS 1
CAIN 1,1↔GO[LAC 1,CHAR↔SETO↔CAIN 1,40↔GO CCONT2
LAC R,ROW↔LAC C,COL
CAMG R,ROWMAX↔CAMGE R,ROWMIN↔GO CCONT2
DOT(R,C)↔GO CCONT2]
CAMN 1,FONT↔GO CCONT3↔DAC 1,FONT
SKIPE FONTAB(1)↔GO CCONT4
DAC 1,FONT↔LAC FNTNAM(1)↔DAC FILNAM
LAC[SIXBIT/FNT/]↔DAC EXTION
LAC FNTPPN↔DAC PPPN
CALL(<DEFONT+1>)
CCONT4: LAC 1,FONT↔CALL(SETFNT)
CCONT3: LAC 1,CHAR↔CALL(PRINT)
CCONT2: POP P,COL↔POP P,ROW ;RESTORE XGP-BEAM POSITION.
CCONT: SOSLE -1(P)↔GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP
;EXECUTE III CONTROL OPERATIONS.
XCTRL: TRNN IIIWRD,04↔GO[CAR 1,IIIWRD↔DAC 1,PC↔GO LOOP] ;JUMP.
TRNE IIIWRD,40↔GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
CAR 2,IIIWRD
CAMLE 2,OLD44
CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
DAC 1,(2)↔DAC 2,PC
GO ILOOP
;EXECUTE VECTORS.
XVECTR: TRNN IIIWRD,4
GO [TRNN IIIWRD,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,IIIWRD,10]↔ROT -13↔DAC X ;X FIELD.
LDB [POINT 11,IIIWRD,21]↔ROT -13↔DAC Y ;Y FIELD
LDB [POINT 3,IIIWRD,24]↔SKIPE↔DAC IIIBRT ;BRIGHTNESS
LDB [POINT 3,IIIWRD,27]↔SKIPE↔DAC IIISIZ ;CHR SIZE
LDB 1,[POINT 3,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
SVECT: PUSH P,IIIWRD ;SAVE III COMMAND.
LDB [POINT 7,IIIWRD,06]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,13]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,15]↔CALL(VECTOR) ;OP CODE.
POP P,IIIWRD ;RESTORE III COMMAND.
LDB [POINT 7,IIIWRD,22]↔ROT -7↔ASH -4↔DAC X ;X FIELD.
LDB [POINT 7,IIIWRD,29]↔ROT -7↔ASH -4↔DAC Y ;Y FIELD.
LDB 1,[POINT 2,IIIWRD,31]↔CALL(VECTOR) ;OP CODE.
GO ILOOP
VECTOR: SETO↔TRNE 1,2↔SETZ ;SKIP ON VISIBLE VECTOR.
TRNE 1,4↔GO .+3 ;SKIP ON RELATIVE VECTOR.
ADD X,XBEAM↔ADD Y,YBEAM
DAC X,XBEAM↔DAC Y,YBEAM
MOVN R,Y↔ADD R,DELTA↔MUL R,IIIDY↔ADD R,BEGROW ;Y INTO ROW.
LAC C,X↔ADD C,DELTA↔MUL C,IIIDX↔ADD C,BEGCOL ;X INTO COL.
TRNE 1,1↔GO VPOINT ;SKIP NOT POINT VECTOR.
LAC 2,ROW↔LAC 3,COL ;FROM OLD XGP BEAM POSITION.
DAC R,ROW↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
SKIPE↔CALL(MKSEG0)↔POP0J ;PLOT VECTOR - POP STACK.
;PLOT A DOT 3 BY 3.
VPOINT: SOS R↔DAC R,ROW↔SOS C↔DAC C,COL ;SAVE NEW XGP BEAM POSITION.
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,1
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)
LAC R,ROW↔LAC C,COL↔ADDI R,2
CAML R,ROWMIN↔CAMLE R,ROWMAX↔POP0J
SETO↔DOT(R,C)↔AOS C↔DOT(R,C)↔AOS C↔DOT(R,C)↔POP0J
DECLARE{XBEAM,YBEAM,IIIBRT,IIISIZ}
CHRWID: 0↔8↔12↔14↔16↔24↔32↔48 ;III CHARACTER WIDTHS.
ENDR IIISIM;2/8/73(TVR)8/21/73(BGB)----------------------------------
DELTA: 0
SUBR(VIDEO)
COMMENT .-----------------------------------------------------------.
COMMENT ⊗ VIDEO FILE HEADER
0 -1
1 6 BITS PER BYTE.
2 =48 WORDS PER ROW.
3 R1
4 R2
5 C1
6 C2
7 -WC,,ADR ⊗
ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2,R,C,TV}
;EXPECT AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH#
LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS#↔DZM TVROW0#
LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS#
LAC R,ROW↔SKIPN DELTA↔GO[LAC TVROWS↔ASH 1↔SUB R,0↔GO .+1]
TRZ R,3 ;UPPER LEFT MOST CORNER OF IMAGE.
CAMLE R,ROWMAX↔POP0J ;WHOLE VIDEO IMAGE BELOW THIS QPAGE.
CAML R,ROWMIN↔GO L0 ;VIDEO IMAGE STARTS ON THIS QPAGE.
;VIDEO IMAGE STARTS BEFORE THIS QUARTER PAGE.
L00: SUB R,ROWMIN↔ASH R,-2
MOVM R,R↔DAC R,TVROW0#
CAML R,TVROWS↔POP0J ;WHOLE VIDEO IMAGE ABOVE THIS QPAGE.
SUB R,TVROWS
MOVMM R,TVROWS↔LAC R,ROWMIN
;VIDEO BYTE POINTER.
L0: LAC P1,1(TV) ;BYTE SIZE.
IORI P1,4400↔ROT P1,-=12
HRR P1,7(TV)↔ADD P1,1 ;ORIGIN OF VIDEO IN CORE.
LAC TVROW0↔IMUL TVWIDTH↔ADD P1,0
;POINTER INTO XGP BUFFER.
LAC C,COL↔SKIPN DELTA↔GO[LAC TVCOLS↔ASH 1↔SUB C,0↔GO .+1]
HLLZ 1,XGP2D(C)↔ROT 1,6
HRRI 1,@XGP2D(R)↔CDR P2,1
;J = COLUMNS/9 9 4-BIT XGP BYTES PER WORD.
MOVEI J,=36↔IDIV J,1(TV)
IMUL J,2(TV)↔IDIVI J,=9↔DAC J,JSAV# ;COLUMNS/9
LAC I,TVROWS
L1: DAC P2,P2SAV#↔LAC J,JSAV
L2: SETZB 0,1↔SETZB 2,3↔MOVEI K,=9
L3: ILDB Q,P1
TRZ Q,3↔ROTC 0,4↔ROTC 2,4
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)↔SOJG K,L3
CAIL C,NCOLS↔GO L4
IORM 0,0*WWIDTH(P2)↔IORM 1,1*WWIDTH(P2)
IORM 2,2*WWIDTH(P2)↔IORM 3,3*WWIDTH(P2)
L4: AOS P2↔SOJG J,L2
ADDI R,4↔CAMLE R,ROWMAX↔POP0J
LAC P2,P2SAV↔ADDI P2,4*WWIDTH
SOJG I,L1
POP0J
;HALF TONE TABLE.
HTT: 6↔7↔7↔6↔ 6↔6↔7↔6↔ 6↔6↔6↔6↔ 6↔6↔6↔6
6↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔6↔6↔4↔ 4↔4↔6↔4
4↔4↔4↔4↔ 4↔4↔4↔4↔ 0↔4↔4↔4↔ 4↔4↔4↔0
0↔4↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔4↔0↔ 0↔0↔0↔0
ENDR VIDEO;6/2/73(BGB)-----------------------------------------------
SUBR(VIDEO2)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{S2,S3,S4,S5,I,J,K,Q,P0,P1,P2,TV}
;EXPECTS AC-1 TO CONTAIN POINTER TO WORD ZERO OF VIDEO FILE IN CORE.
LAC TV,1↔LAC 2(TV)↔DAC TVWIDTH# ;WORDS PER ROW.
LAC 4(TV)↔SUB 3(TV)↔AOS↔DAC TVROWS# ;NUMBER OF ROWS.
LAC 6(TV)↔SUB 5(TV)↔AOS↔DAC TVCOLS# ;NUMBER OF COLUMNS.
L0: LAC P1,1(TV)↔IORI P1,4400↔ROT P1,-=12 ;VIDEO BYTE POINTER
HRR P1,7(TV)↔ADD P1,1 ;FIRST-1 PIXEL.
LAC P2,ORGXGP↔ADDI P2,WWIDTH-1 ;LAST WORD OF FIRST ROW.
;LOOP I←1,288 TV COLUMNS.
MOVEI I,=288 ;NUMBER OF TVCOLUMNS.
L1: IBP P1↔DAC P1,P0
;LOOP J←1,(206/6) TV ROWS.
MOVEI J,=35 ;NUMBER OF TV ROWS/6.
L2: SETZB 0,1↔SETZB 2,3↔SETZB 4,5 ;CLEAR 6 WORDS FOR XGP BITS.
;LOOP K←1,6 FOR SIX VIDEO PIXELS.
MOVEI K,=6
L3: LDB Q,P0↔ADD P0,TVWIDTH ;TV PIXEL & NEXT TV ROW.
TRZ Q,3↔LSH Q,1
IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
IOR 4,HTT+4(Q)↔IOR 5,HTT+5(Q)
ROTC 0,-6↔ROTC 2,-6↔ROTC 4,-6
SOJG K,L3 ;LOOP FOR SIX VIDEO PIXELS.
;PACK SIX VIDEO PIXELS INTO XGP-BUFFER.
IORM 1,0*WWIDTH(P2)↔IORM 0,1*WWIDTH(P2)
IORM 3,2*WWIDTH(P2)↔IORM 2,3*WWIDTH(P2)
IORM 5,4*WWIDTH(P2)↔IORM 4,5*WWIDTH(P2)
L4: SOS P2↔SOJG J,L2 ;LEFT 36 XGP PIXELS.
ADDI P2,7*WWIDTH-1 ;DOWN 7 XGP ROWS (6 ROWS PER TV-COL + 1 ROW TO BACKUP ON)
SOJG I,L1↔POP0J ;LOOP FOR TV ROWS/6.
;6 BY 6 HALF TONE TABLE.
HTT: 17↔17↔17↔17 ↔0↔0↔0↔0 ;00 DARK.
7↔17↔17↔17 ↔0↔0↔0↔0
7↔ 7↔17↔17 ↔0↔0↔0↔0
7↔ 7↔ 7↔17 ↔0↔0↔0↔0
17↔17↔17↔00 ↔0↔0↔0↔0
17↔17↔ 7↔00 ↔0↔0↔0↔0
17↔ 7↔ 7↔00 ↔0↔0↔0↔0
7↔ 7↔ 7↔00 ↔0↔0↔0↔0
7↔ 7↔ 3↔00 ↔0↔0↔0↔0
7↔ 7↔ 1↔00 ↔0↔0↔0↔0
7↔ 7↔ 0↔00 ↔0↔0↔0↔0
3↔ 7↔ 0↔00 ↔0↔0↔0↔0
0↔ 0↔ 1↔ 7 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 7 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 3 ↔0↔0↔0↔0
0↔ 0↔ 0↔ 1 ↔0↔0↔0↔0
ENDR VIDEO2;BGB 25 MAY 1974 ---------------------------------------------
SUBR(INFILE) INDIRECT FILE COMMAND "@".
COMMENT .-----------------------------------------------------------.
;FILE INITIALIZATION.
INIT 1,17↔SIXBIT/DSK/↔0
GO[FATAL(CAN'T INIT DSK)]
CALL(GETFIL)↔POP0J
LOOKUP 1,FILNAM↔GO[
OUTSTR[ASCIZ/FILE NOT FOUND - /]
POP P,1↔LAC 2,[POINT 7,4]↔MOVEI 3,=25
ILDB 1↔CAIN";"↔GO $.+3↔IDPB 2↔SOJG 3,$.-4
SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT]
;EXPAND CORE WHEN NECESSARY.
HLRE PPPN↔MOVMS↔DAC SIZE# ;WORD COUNT.
IMULI =5↔DAC CHRCNT ;NEW CHARACTER COUNT.
LAC 1,TXTORG↔ADD 1,SIZE↔DAP 1,JOBFF ;NEW TOP OF CORE.
CDR 1,JOBFF↔CAMG 1,JOBREL↔GO .+3 ;EXPAND CORE.
CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]
;INPUT THE FILE.
CDR TXTORG↔HRLI 700↔DAC TXTPTR ;RESET TEXT POINTER.
HLL PPPN↔DAC DUMARG ;DUMP MODE ARGUMENT.
IN 1,DUMARG↔SKIPA↔HALT ;INPUT THE FILE.
RELEASE 1,↔DZM CMODE ;ENTER TEXT MODE.
;SKIP OVER TEXT DIRECTORY IF IT EXISTS.
LAC 2,TXTPTR
LAC 3,[POINT 7,[ASCIZ/COMMENT ⊗ VALID/]]
ILDB 0,2↔ILDB 1,3↔JUMPN 1,[
CAME 0,1↔POP0J↔GO .-2]
CALL(GETCHR)
CAIE 1,14↔GO .-2↔POP0J
DUMARG:0↔0
ENDR INFILE;5/30/73(BGB)---------------------------------------------
;XIP COMMAND EXECUTION.
;ABSOLUTE INVISIBLE VECTOR.
AI: CALL(REALIN)↔FIXX↔DAC ROW ;I <row>, <col>;
CALL(REALIN)↔FIXX↔DAC COL↔POP0J
;ABSOLUTE VISIBLE VECTOR.
AV: CALL(REALIN)↔FIXX↔DAC 4 ;V <row>, <col>;
CALL(REALIN)↔FIXX↔DAC 5
LAC 2,ROW↔LAC 3,COL ;FROM HITHER.
DAC 3,ROW↔DAC 5,COL ; TO YON.
CALL(MKSEG0)↔POP0J
;RADIAL VECTOR AT DEFAULT ORIENTATION ABOUT PSEUDO BEAM POSITION.
XRADIAL: ;R <radius1> <radius2>
CALL(REALIN)↔DAC 5↔DAC 5,4
CALL(REALIN)↔DAC 3↔DAC 3,2
FMP 2,SINE↔MOVNS 2↔FIXX 2,↔ADD 2,ROW
FMP 4,SINE↔MOVNS 4↔FIXX 4,↔ADD 4,ROW
FMP 3,COSINE↔FIXX 3,↔ADD 3,COL
FMP 5,COSINE↔FIXX 5,↔ADD 5,COL
CALL(MKSEG0)↔POP0J
XXSCAL:
CALL(REALIN)↔DAC SCALEX↔DAC SCALEY ;X <scale> ;
FMPR[1024.]↔FIXX↔DAC IIIDX↔DAC IIIDY↔POP0J
YYSCAL:
CALL(REALIN)↔DAC SCALEY ;Y <scale> ;
FMPR[1024.]↔FIXX↔DAC IIIDY↔POP0J
XROTAT:
CALL(READARC)↔PUSH P,1↔DAC ROTDEL ;O <angle> ;
SETQ(SINE,{SIN,ROTDEL})
SETQ(COSINE,{COS,ROTDEL})
POP P,1↔CAIE 1,","↔POP0J
CALL(REALIN)↔DAC LOCUSX
CALL(REALIN)↔DAC LOCUSY
POP0J
XLOCUS:
CALL(REALIN)↔FADR LOCUSX↔FIXX↔DAC COL ;L <X>, <Y>;
CALL(REALIN)↔FSBR LOCUSY↔FIXX↔MOVNM ROW
XLOC2: CAIE 1,","↔POP0J
CALL(REALIN)↔FADR LOCUSX↔FIXX↔LAC 3,COL↔DAC COL↔LAC 5,COL
CALL(REALIN)↔FSBR LOCUSY↔FIXX↔LAC 2,ROW↔MOVNM ROW↔LAC 4,ROW
PUSH P,1↔CALL(MKSEG0)↔POP P,1
GO XLOC2
LOCUSX: 630.0
LOCUSY: 950.0
XSETPAGE:
CALL(REALIN)↔FIXX↔MOVMM PAGENO↔POP0J ;P <page number>;
XHEAVY:
CALL(REALIN)↔FIXX↔MOVMM HEAVY↔POP0J ;H <THICKNESS>;
MKSECT:
LAC TXTPTR↔DAC HEADER↔SETZM HEADCN ;"α <section title>;"
CALL(GETCHR)
CAIN 1,";"↔GO[SETZM HEADER↔POP0J] ;EMPTY HEADER ";".
SKIPA
CALL(GETCHR)↔AOS HEADCN↔CAIE 1,";"↔GO .-3
MOVEI 15↔DPB TXTPTR↔POP0J
SUBR(SQRT,X)
COMMENT .-----------------------------------------------------------.
A←0 ↔ B←←1 ↔ C←2
MOVM B,X↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J
ENDR SQRT;--------------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,-1(P)
↑SIN: SKIPA A,-1(P)
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:201622077325↔LIT ;PI/2
BEND;-------------------------------------------------------------
HALFPI: 201622077325 ;PI/2
PI: 202622077325 ;PI
SUBR(REALIN)
COMMENT .-----------------------------------------------------------.
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
ENDR REALIN
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
SUBR(PRIMARY)
COMMENT .---------------------------------------------------------------------.
CNT ←← 2 ;DIGIT COUNTER.
SETZB SIGNFLAG#
PUSH P,CNT↔SETZ CNT,
L0: CALL(GETCHR)
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM SIGNFLAG↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: CALL(GETCHR)↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔POP P,2↔POP0J]
SKIPA
L1: CALL(GETCHR) ;FURTHER DIGITS.
CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE SIGNFLAG↔MOVNS
POP P,2↔POP0J
ENDR PRIMARY;------------------------------------------------------------------
SUBR(READARC)
COMMENT .-----------------------------------------------------------.
CALL(REALIN)
JUMPL[CAMG[6.3]↔FMPR[0.0174533]↔POP0J]
CAML[6.3]↔FMPR[0.0174533]
POP0J
ENDR READARC;--------------------------------------------------------
SUBR(DPYDOT,X,Y) ;DISPLAY A DOT.
COMMENT .---------------------------------------------------------------------.
;PLACE A DOT AT LOCUS (X,Y).
;DILATION, ROTATION, TRANSLATION, & CLIP.
ACCUMULATORS{R,C}
LAC R,X↔LAC C,Y
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
CAMGE R,ROWMIN↔POP2J ;CLIP.
CAMLE R,ROWMAX↔POP2J
SKIPGE C↔POP2J
CAILE C,NCOLS
SETO↔DOT(R,C)↔POP2J ;DISPLAY.
ENDR DPYDOT;-------------------------------------------------------------------
SUBR(MKSEG3)
COMMENT .---------------------------------------------------------------------.
R←←2 ↔ C←←3
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL
R←←4 ↔ C←←5
EXCH R,C
FMP R,SCALEY↔LAC 0,R ;DILATION.
FMP C,SCALEX↔LAC 1,C
FMP 0,SINE↔FMP R,COSINE ;ROTATION.
FMP 1,SINE↔FMP C,COSINE
FADR R,1↔FSBR C,0↔MOVNS R
FIXX R,↔ADD R,ROW ;TRANSLATION.
FIXX C,↔ADD C,COL↔GO MKSEG0
ENDR MKSEG3;-------------------------------------------------------------------
SUBR(RNDBOX,WID,HGH,RAD) ;BOX WITH ROUNDED CORNERS AT ROW,COL.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{R1,C1,R2,C2,R,C}
LAC R1,ROW↔SUB R1,HGH↔AOS R1↔DAC R1,R2
LAC C1,COL↔SUB C1,WID↔ADD C1,RAD↔SUBI C1,2
LAC C2,COL↔ADD C2,WID↔SUB C2,RAD↔ADDI C2,2
CALL(MKSEG0) ;NORTH EDGE.
LAC R1,ROW↔ADD R1,HGH↔SUB R1,HEAVY↔AOS R1↔DAC R1,R2
LAC C1,COL↔SUB C1,WID↔ADD C1,RAD↔SUBI C1,2
LAC C2,COL↔ADD C2,WID↔SUB C2,RAD↔ADDI C2,2
CALL(MKSEG0) ;SOUTH EDGE.
LAC C1,COL↔SUB C1,WID↔DAC C1,C2
LAC R1,ROW↔SUB R1,HGH↔ADD R1,RAD
LAC R2,ROW↔ADD R2,HGH↔SUB R2,RAD
CALL(MKSEG0) ;WEST EDGE.
LAC C1,COL↔ADD C1,WID↔SUB C1,HEAVY↔DAC C1,C2
LAC R1,ROW↔SUB R1,HGH↔ADD R1,RAD
LAC R2,ROW↔ADD R2,HGH↔SUB R2,RAD↔CALL(MKSEG0) ;EAST EDGE.
LAC RAD↔FLOAT↔DAC FRAD# ;FLOAT THE RADIUS.
LAC R,ROW↔DAC R,SAVROW# ;SAVE BEAM POSITION.
LAC C,COL↔DAC C,SAVCOL#
SUB R,HGH↔ADD R,RAD↔DAC R,ROW
ADD C,WID↔SUB C,RAD↔DAC C,COL
CALL(CIRC,FRAD,[0],HALFPI) ;NORTHEAST CORNER.
LAC RAD↔SUB WID↔ASH 1↔ADDM COL
CALL(CIRC,FRAD,HALFPI,HALFPI) ;NORTHWEST CORNER.
LAC HGH↔SUB RAD↔ASH 1↔ADDM ROW
CALL(CIRC,FRAD,PI,HALFPI) ;SOUTHWEST CORNER.
LAC WID↔SUB RAD↔ASH 1↔ADDM COL
MOVN HALFPI↔CALL(CIRC,FRAD,0,HALFPI) ;SOUTHEAST CORNER.
LAC SAVROW↔DAC ROW↔LAC SAVCOL↔DAC COL ;RESTORE BEAM POSITION.
POP3J
ENDR RNDBOX;-------------------------------------------------------------------
SUBR(XBOX) ;"B <width> <height>"
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{X1,Y1,X2,Y2}
CALL(REALIN) ↔ MOVMM PDX# ↔ MOVNM NDX# ↔ CAIE 1,";"
CALL(REALIN) ↔ MOVMM PDY# ↔ MOVNM NDY#
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,NDX↔LAC Y2,PDY↔CALL(MKSEG3) ;WEST.
LAC X1,PDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;EAST.
LAC X1,NDX↔LAC Y1,NDY↔LAC X2,PDX↔LAC Y2,NDY↔CALL(MKSEG3) ;SOUTH.
LAC X1,NDX↔LAC Y1,PDY↔LAC X2,PDX↔LAC Y2,PDY↔CALL(MKSEG3) ;NORTH.
POP0J
ENDR XBOX;--------------------------------------------------------------------.
SUBR(XSWINE) ;"S <WIDTH> <HEIGHT> <RADIUS> "
COMMENT .---------------------------------------------------------------------.
CALL(REALIN)↔DAC 7 ;HALF WIDTH
CALL(REALIN)↔DAC 8 ;HALF HEIGHT.
CALL(REALIN)↔DAC 9 ;RADIUS.
FIXX 7,↔FIXX 8,↔FIXX 9,
CALL(RNDBOX,7,8,9)↔POP0J
ENDR XSWINE;-------------------------------------------------------------------
SUBR(CARTOUCHE) ;"|" CARTOUCHE DELIMITER.
COMMENT .---------------------------------------------------------------------.
LAC ROW↔SKIPN ROW0↔GO[DAC ROW0
LAC COLMIN↔DAC CMIN↔ADDI =50↔DAC COLMIN
LAC COLMAX↔DAC CMAX↔SUBI =50↔DAC COLMAX↔POP0J] ;NARROW THE MARGINS.
DAC ROW1
PUSH P,ROW↔PUSH P,COL↔PUSH P,HEAVY ;SAVE STATUS.
MOVEI 7↔DAC HEAVY
MOVEI NCOLS↔ASH -1↔DAC COL ;MIDDLE OF THE PAGE.
LAC ROW0↔ADD ROW1↔ASH -1↔DAC ROW ;MIDDLE OF THE BOX.
LAC ROW1↔SUB ROW0↔ASH -1
CALL(RNDBOX,[=630],0,[=72])
POP P,HEAVY↔POP P,COL↔POP P,ROW ;RESTORE STATUS.
LAC CMIN↔DAC COLMIN↔LAC CMAX↔DAC COLMAX ;RESTORE THE MARGINS.
DZM ROW0↔POP0J
DECLARE{ROW0,ROW1,COL0,COL1,CMIN,CMAX}
ENDR CARTOUCHE;----------------------------------------------------------------
SUBR(CIRC,RAD,ARCORG,ARCLEN) ;RADIUS - ARC ORG - ARC LENGTH.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{R,C,X,Y,N,M,E}
LAC M,HEAVY
L1: CALL(COS,ARCORG)↔FMPR 1,RAD↔FIXX 1,↔DAC 1,XX
CALL(SIN,ARCORG)↔FMPR 1,RAD↔FIXX 1,↔DAC 1,YY
LAC R,RAD↔FIXX R,
JFFO R,.+1↔MOVEI E,-=36(C) ;ARC EPSILON = 1/R > 1/2↑E
LAC N,ARCLEN↔MOVN 1,E
FSC N,(1)↔FIXX N,↔DAC N,NN ;ACTUAL DOT COUNT ← ARCLEN*2↑E
SETO
LAC X,XX↔LAC Y,YY↔LAC N,NN ;PICKUP ARGUMENTS.
ASH X,=18↔ASH Y,=18
L2: HLRE C,X↔HLRE R,Y↔MOVNS R
ADD R,ROW↔ADD C,COL
CAMGE R,ROWMIN↔GO L3 ;CLIP TO ROW LIMITS.
CAMLE R,ROWMAX↔GO L3
JUMPL C,L3↔CAIL C,NCOLS↔GO L3 ;CLIP TO COLUMN LIMITS.
DOT(R,C)
L3: LAC 1,Y↔ASH 1,(E)↔SUB X,1 ;X ← X - Y/2↑-E
LAC 1,X↔ASH 1,(E)↔ADD Y,1 ;Y ← Y + X/2↑-E
SOSLE N↔GO L2
SOSGE M↔POP3J ;HEAVINESS.
LAC RAD↔FSB[1.0]↔DAC RAD
GO L1
DECLARE{XX,YY,NN}
ENDR CIRC;---------------------------------------------------------------------
SUBR(XCIRCLE)
COMMENT .---------------------------------------------------------------------.
SETZ 8,↔LAC 9,[6.29] ;DEFAULTS.
CALL(REALIN)↔PUSH P,0↔CAIN 1,";"↔GO L2 ;RADIUS.
CALL(REALIN)↔DAC 8↔CAIN 1,";"↔GO L2 ;ARC ORGIN.
CALL(REALIN)↔DAC 9 ;ARC LENGTH.
L2: CALL(CIRC,8,9)↔POP0J
ENDR XCIRCLE;------------------------------------------------------------------
END SA